Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/C/Applications/GW AdaEd 1.4.2/GWAdaDemos/NYUDemos/PAGER_PART1.ADA

Text File | 1994-01-09 | 12.8 KB | 436 lines | [TEXT/GADA]

-- PROGRAM/CODE BODY NAME:    PAGER2
-- AUTHOR:            Richard Conn
-- VERSION:            1.1
-- DATE:            6/12/89
-- REVISION HISTORY -
-- Version    Date    Author        Comments
--    1.0    8/28/87    Richard Conn    Initial
--    1.1       6/12/89 Richard Conn    CLI interface added
-- KEYWORDS -
--    pager, pager2, paged files, page, unpage
-- CALLING SYNTAX -
--    From the command line: pager2
--    From the command line: pager2 verb arguments
-- EXTERNAL ROUTINES -
--    Package CLI
--    Package TEXT_IO
-- DESCRIPTION -
--    PAGER2 assembles, extracts elements from, and lists paged files.
-- Paged files are text files which contain one or more component files
-- prefixed by a banner like:
--
--    ::::::::::
--    filename
--    ::::::::::
--
-- or
--
--    --::::::::::
--    --filename
--    --::::::::::
--
--    PAGER2 will manipulate paged files whose components
-- are prefixed with either banner, but it assembles paged files with only
-- the second banner (beginning with the Ada comment characters).

--===========================================================================
-------------------------- PACKAGE LINE_DEFINITION --------------------------
--===========================================================================

-- The following package defines an object of type LINE
package LINE_DEFINITION is

    -- The maximum length of a line
    MAX_LINE_LENGTH : constant NATURAL := 200;

    -- Type definition for LINE
    type LINE is record
    CONTENT : STRING(1 .. MAX_LINE_LENGTH);
    LAST    : NATURAL;
    end record;
    type LINE_LIST_ELEMENT;
    type LINE_LIST        is access LINE_LIST_ELEMENT;
    type LINE_LIST_ELEMENT is record
    CONTENT : LINE;
    NEXT    : LINE_LIST;
    end record;

    -- Banners
    COMMENT_BANNER  : constant STRING  := "--::::::::::";
    BANNER          : constant STRING  := "::::::::::";

    -- Convert strings to LINEs and back
    function CONVERT(FROM : in STRING) return LINE;
    function CONVERT(FROM : in LINE) return STRING;

    -- Convert a LINE to lower-case characters
    procedure TOLOWER(ITEM : in out LINE);
    function TOLOWER(ITEM : in LINE) return LINE;

end LINE_DEFINITION;

package body LINE_DEFINITION is

    -- Convert strings to LINEs
    function CONVERT(FROM : in STRING) return LINE is
    TO : LINE_DEFINITION.LINE;
    begin
    TO.CONTENT(TO.CONTENT'FIRST .. TO.CONTENT'FIRST + FROM'LENGTH - 1) :=
      FROM;
    TO.LAST := FROM'LENGTH;
    return TO;
    end CONVERT;

    function CONVERT(FROM : in LINE) return STRING is
    begin
    return FROM.CONTENT(FROM.CONTENT'FIRST .. FROM.LAST);
    end CONVERT;

    procedure TOLOWER(ITEM : in out LINE) is
    begin
    for I in ITEM.CONTENT'FIRST .. ITEM.LAST loop
        if ITEM.CONTENT(I) in 'A' .. 'Z' then
        ITEM.CONTENT(I) :=
                  CHARACTER'VAL(CHARACTER'POS(ITEM.CONTENT(I)) -
          CHARACTER'POS('A') + CHARACTER'POS('a'));
        end if;
    end loop;
    end TOLOWER;

    function TOLOWER(ITEM : in LINE) return LINE is
        MYLINE : LINE;
    begin
        MYLINE := ITEM;
        TOLOWER(MYLINE);
        return MYLINE;
    end TOLOWER;

end LINE_DEFINITION;

--===========================================================================
-------------------------- PACKAGE INPUT_FILE -------------------------------
--===========================================================================

-- The following package manipulates an object called an INPUT_FILE,
-- which is a text file that is composed of objects of type LINE.
-- LINEs can only be read from an INPUT_FILE.
with LINE_DEFINITION;
package INPUT_FILE is

    -- Open the input file
    -- Exceptions which may be raised: FILE_NOT_FOUND, FILE_ALREADY_OPEN
    procedure OPEN(FILE_NAME : in STRING);
    procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE);

    -- Close the input file
    -- Exceptions which may be raised: FILE_NOT_OPEN
    procedure CLOSE;

    -- Read a line from the input file
    -- Exceptions which may be raised: FILE_NOT_OPEN, READ_PAST_END_OF_FILE
    procedure READ(TO : out LINE_DEFINITION.LINE);

    -- Return TRUE if the input file is empty (no more lines remain)
    -- Exceptions which may be raised: FILE_NOT_OPEN
    function END_OF_FILE return BOOLEAN;

    -- Exceptional conditions
    FILE_NOT_FOUND        : exception;
    FILE_ALREADY_OPEN     : exception;
    FILE_NOT_OPEN         : exception;
    READ_PAST_END_OF_FILE : exception;

end INPUT_FILE;

with TEXT_IO;
package body INPUT_FILE is

    -- The file descriptor for the input file
    FD : TEXT_IO.FILE_TYPE;

    -- Open the input file
    procedure OPEN(FILE_NAME : in STRING) is
    begin
    TEXT_IO.OPEN(FD, TEXT_IO.IN_FILE, FILE_NAME);
    exception
    when TEXT_IO.NAME_ERROR =>
        raise FILE_NOT_FOUND;
    when TEXT_IO.STATUS_ERROR =>
        raise FILE_ALREADY_OPEN;
    end OPEN;

    procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE) is
    begin
    OPEN(LINE_DEFINITION.CONVERT(FILE_NAME));
    end OPEN;

    -- Close the input file
    procedure CLOSE is
    begin
    TEXT_IO.CLOSE(FD);
    exception
    when TEXT_IO.STATUS_ERROR =>
        raise FILE_NOT_OPEN;
    end CLOSE;

    -- Read a line from the input file
    procedure READ(TO : out LINE_DEFINITION.LINE) is
    begin
    TEXT_IO.GET_LINE(FD, TO.CONTENT, TO.LAST);
    exception
    when TEXT_IO.END_ERROR =>
        raise READ_PAST_END_OF_FILE;
    when TEXT_IO.STATUS_ERROR =>
        raise FILE_NOT_OPEN;
    end READ;

    -- Return TRUE if the input file is empty (no more lines remain)
    function END_OF_FILE return BOOLEAN is
    begin
    return TEXT_IO.END_OF_FILE(FD);
    exception
    when TEXT_IO.STATUS_ERROR =>
        raise FILE_NOT_OPEN;
    end END_OF_FILE;

end INPUT_FILE;

--===========================================================================
-------------------------- PACKAGE OUTPUT_FILE ------------------------------
--===========================================================================

-- The following package manipulates an object called an OUTPUT_FILE,
-- which is a text file that is composed of objects of type LINE.
-- LINEs can only be written to an OUTPUT_FILE.
with LINE_DEFINITION;
package OUTPUT_FILE is

    -- Open the output file
    -- Exceptions which may be raised: CANNOT_CREATE_FILE, FILE_ALREADY_OPEN
    procedure OPEN(FILE_NAME : in STRING);
    procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE);

    -- Close the output file
    -- Exceptions which may be raised: FILE_NOT_OPEN
    procedure CLOSE;

    -- Write a line to the output file
    -- Exceptions which may be raised: FILE_NOT_OPEN, DISK_FULL
    procedure WRITE(FROM : in LINE_DEFINITION.LINE);
    procedure WRITE(FROM : in STRING);

    -- Exceptional conditions
    CANNOT_CREATE_FILE : exception;
    FILE_ALREADY_OPEN  : exception;
    FILE_NOT_OPEN      : exception;
    DISK_FULL          : exception;

end OUTPUT_FILE;

with TEXT_IO;
package body OUTPUT_FILE is

    -- File descriptor for the output file
    FD : TEXT_IO.FILE_TYPE;

    -- Open the output file
    procedure OPEN(FILE_NAME : in STRING) is
    INLINE : STRING(1 .. 80);
    LAST   : NATURAL;
    begin
    TEXT_IO.CREATE(FD, TEXT_IO.OUT_FILE, FILE_NAME);
    exception
    when TEXT_IO.STATUS_ERROR =>
        raise FILE_ALREADY_OPEN;
    when TEXT_IO.USE_ERROR =>
        raise CANNOT_CREATE_FILE;
    when TEXT_IO.NAME_ERROR =>
        TEXT_IO.PUT_LINE(" Cannot create " & FILE_NAME);
        loop
        begin
            TEXT_IO.PUT(" Enter New File Name: ");
            TEXT_IO.GET_LINE(INLINE, LAST);
            TEXT_IO.CREATE(FD, TEXT_IO.OUT_FILE,
              INLINE(INLINE'FIRST .. LAST));
            exit;
        exception
            when TEXT_IO.NAME_ERROR =>
            TEXT_IO.PUT_LINE(" Cannot create " &
              INLINE(INLINE'FIRST .. LAST));
            when others =>
            raise ;
        end;
        end loop;
    end OPEN;

    procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE) is
    begin
    OPEN(LINE_DEFINITION.CONVERT(FILE_NAME));
    end OPEN;

    -- Close the output file
    procedure CLOSE is
    begin
    TEXT_IO.CLOSE(FD);
    exception
    when TEXT_IO.STATUS_ERROR =>
        raise FILE_NOT_OPEN;
    end CLOSE;

    -- Write a line to the output file
    procedure WRITE(FROM : in LINE_DEFINITION.LINE) is
    begin
    TEXT_IO.PUT_LINE(FD, LINE_DEFINITION.CONVERT(FROM));
    exception
    when TEXT_IO.STATUS_ERROR =>
        raise FILE_NOT_OPEN;
    when others =>
        raise DISK_FULL;
    end WRITE;

    procedure WRITE(FROM : in STRING) is
    begin
    WRITE(LINE_DEFINITION.CONVERT(FROM));
    end WRITE;

end OUTPUT_FILE;

--===========================================================================
-------------------------- PACKAGE INCLUDE_FILE -----------------------------
--===========================================================================

-- The following package manipulates an object called an INCLUDE_FILE,
-- which is a text file that is composed of objects of type LINE.
-- LINEs can only be read from an INCLUDE_FILE.  An INCLUDE_FILE contains
-- the following types of LINE objects:
--    blank lines
--    comment lines ('-' is the first character in the line)
--    file names (a string of non-blank characters which does not
--        begin with the character '-' or '@')
--    include file names (a string of non-blank characters which
--        begins with the character '@', where the '@' is used to
--        prefix the file name within the include file and is not
--        a part of the file name of the actual disk file)
-- Include files may be nested several levels (defined by the constant
-- NESTING_DEPTH).
with LINE_DEFINITION;
package INCLUDE_FILE is

    -- Maximum number of levels include files may be nested
    NESTING_DEPTH     : constant NATURAL   := 40;

    -- Character which begins an include file name
    INCLUDE_CHARACTER : constant CHARACTER := '@';

    -- Character which begins a comment line
    COMMENT_CHARACTER : constant CHARACTER := '-';

    -- Open the include file (the LINE input string contains the leading '@')
    -- Exceptions which may be raised: FILE_NOT_FOUND, NESTING_LEVEL_EXCEEDED
    procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE);
    procedure OPEN(FILE_NAME : in STRING);

    -- Read a LINE containing a file name from the include file
    -- Exceptions which may be raised: FILE_NOT_OPEN, READ_PAST_END_OF_FILE
    procedure READ(TO : out LINE_DEFINITION.LINE);

    -- Abort processing the include file (close all open files)
    -- Exceptions which may be raised: FILE_NOT_OPEN
    procedure STOP;

    -- Exceptional conditions
    FILE_NOT_FOUND         : exception;
    NESTING_LEVEL_EXCEEDED : exception;
    FILE_NOT_OPEN          : exception;
    READ_PAST_END_OF_FILE  : exception;
    INCLUDE_FILE_EMPTY     : exception;

end INCLUDE_FILE;

with TEXT_IO;
package body INCLUDE_FILE is

    -- File Descriptor for main include file
    FD              : array(1 .. NESTING_DEPTH) of TEXT_IO.FILE_TYPE;
    CURRENT_LEVEL   : NATURAL := 0;
    NEXT_LINE       : LINE_DEFINITION.LINE;    -- next line to return by READ
    NEXT_LINE_READY : BOOLEAN := FALSE;        -- indicates next line is
                                               -- available

    -- Open the include file (the LINE input string contains the leading '@')
    -- Exceptions which may be raised: FILE_NOT_FOUND, NESTING_LEVEL_EXCEEDED
    procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE) is
    begin
    if CURRENT_LEVEL = NESTING_DEPTH then
        raise NESTING_LEVEL_EXCEEDED;
    else
        CURRENT_LEVEL := CURRENT_LEVEL + 1;
        TEXT_IO.OPEN(FD(CURRENT_LEVEL), TEXT_IO.IN_FILE,
          FILE_NAME.CONTENT(2..FILE_NAME.LAST));
    end if;
    exception
    when TEXT_IO.NAME_ERROR =>
        TEXT_IO.PUT_LINE("Include File " &
          LINE_DEFINITION.CONVERT(FILE_NAME) &
              " not Found");
        raise FILE_NOT_FOUND;
    when others =>
        TEXT_IO.PUT_LINE("Unexpected error with Include File " &
          LINE_DEFINITION.CONVERT(FILE_NAME));
        raise FILE_NOT_FOUND;
    end OPEN;

    procedure OPEN(FILE_NAME : in STRING) is
    begin
    OPEN(LINE_DEFINITION.CONVERT(FILE_NAME));
    end OPEN;

    -- Close the include file
    -- Exceptions which may be raised: FILE_NOT_OPEN
    procedure CLOSE is
    begin
    TEXT_IO.CLOSE(FD(CURRENT_LEVEL));
    CURRENT_LEVEL := CURRENT_LEVEL - 1;
    if CURRENT_LEVEL = 0 then
        raise INCLUDE_FILE_EMPTY;
    end if;
    end CLOSE;

    -- Abort processing the include file
    procedure STOP is
    begin
    while CURRENT_LEVEL > 0 loop
        TEXT_IO.CLOSE(FD(CURRENT_LEVEL));
        CURRENT_LEVEL := CURRENT_LEVEL - 1;
    end loop;
    end STOP;

    -- Read a LINE containing a file name from the include file
    -- Exceptions which may be raised: FILE_NOT_OPEN, READ_PAST_END_OF_FILE
    procedure READ(TO : out LINE_DEFINITION.LINE) is
    INLINE : LINE_DEFINITION.LINE;
    begin
    loop
        begin
        TEXT_IO.GET_LINE(FD(CURRENT_LEVEL), INLINE.CONTENT,
          INLINE.LAST);
        if INLINE.LAST > 0 and INLINE.CONTENT(1) =
          INCLUDE_CHARACTER then
            OPEN(INLINE);
        elsif (INLINE.LAST > 0 and INLINE.CONTENT(1) = COMMENT_CHARACTER) or
          (INLINE.LAST = 0) then
            null;    -- skip comment lines and empty lines
        else
            exit;
        end if;
        exception
        when TEXT_IO.END_ERROR =>
            CLOSE;
        end;
    end loop;
    TO := INLINE;
    end READ;

end INCLUDE_FILE;